home *** CD-ROM | disk | FTP | other *** search
/ PC World 2008 March / PCWorld_2008-03_cd.bin / v cisle / pcwmultilink / pcwMultilink.V2.exe / pcwMultilink.V2.VBS
Text File  |  2008-01-22  |  7KB  |  180 lines
  1. ' pcwMultilink.V2 slou₧φ k pohodlnΘmu vytvß°enφ multifunkΦnφch ikon na pracovnφ plochu.
  2. ' Do automaticky otev°enΘ slo₧ky Links.TMP umφstφte vÜechny zßstupce program∙, slo₧ek Φi soubor∙, 
  3. ' kterΘ se majφ v multifunkΦnφ ikon∞ objevit.
  4. ' Na zßklad∞ t∞chto polo₧ek vytvo°φ skript ikonku, kterß bude v kontextovΘm menu obsahovat 
  5. ' vÜechny vßmi po₧adovanΘ odkazy. 
  6. ' Zßstupci ve slo₧ce Links.TMP a slo₧ka samotnß se po ukonΦenφ skriptu automaticky odstranφ.
  7. '
  8. ' Skript se nijak neinstaluje, lze jej umφstit do livbovolnΘ slo₧ky a libovoln∞ p°esouvat Φi p°ejmenovat.
  9. ' Skript spustφte poklepßnφm-
  10. ' MultifunkΦnφ ikonu odstranφte tak, ₧e ji upustφte na ikonu souboru skriptu.
  11.  
  12. dim menuname(50)
  13. dim programm(50)
  14. dim ziel(50)
  15. dim Parameter(50)
  16. dim myDesktop
  17. Set myfiles = CreateObject("Scripting.FileSystemObject")
  18. Set myshell = CreateObject("Wscript.Shell")
  19. Set myEnv = myShell.Environment("PROCESS")
  20. set myArgs=wscript.arguments
  21. mydesktop=myShell.SpecialFolders("Desktop")
  22. tempfolder=myEnv("TEMP") & "\Links.TMP"
  23.  
  24. 'Drag & Drop (Odstranit multifunkΦnφ ikonu) ?
  25. if myArgs.Count > 0 then 
  26.     DeleteLink myArgs(0)
  27.     wscript.quit
  28. end if
  29.  
  30. on error resume next
  31. MyFiles.CreateFolder(tempfolder)
  32. myShell.run "explorer.exe /n," & tempfolder,1,true
  33. wscript.sleep 1000
  34. msgbox "Umφst∞te, prosφm, po₧adovanΘ zßstupce do otev°enΘ slo₧ky 'Links.tmp'." _
  35.     & chr(13) & chr(13) & "P°φpadn∞ opravte nßzvy zßstupc∙." _
  36.     & chr(13) & chr(13) & "P°φpony u soubor∙ jako nap°φklad '.EXE' se odeberou automaticky." _
  37.     & chr(13) & "╪et∞zec 'Zßstupce -' ('Shortcut to') se rovn∞₧ odstranφ." _
  38.     & chr(13) & "Ostatnφ znaky v nßzvu (malß/velkß pφsmena atd.) se objevφ v kontextovΘm menu" _
  39.      & chr(13) & " multifunkΦnφ ikony p°esn∞ tak, jako by se jednalo o nßzev obyΦejnΘho zßstupce." _
  40.     & chr(13) & chr(13) & "Nakonec, po vytvo°enφ vÜech polo₧ek kontextovΘho menu, pokraΦujte stiskem 'OK' ..." _
  41.     & chr(13) & chr(13) & "(Zßstupci doΦasn∞ vytvo°enφ ve slo₧ce 'Links.tmp' se odstranφ automaticky.)",," Vytvo°it novou multifunkΦnφ ikonu"
  42.  
  43. set lnkfolder=MyFiles.Getfolder(tempfolder)
  44. set linkfiles=lnkfolder.Files
  45. for each link in linkfiles
  46.     check=ucase(right(link.name,4))
  47.     if check=".LNK" Or check=".PIF" then
  48.         clink=clink+1
  49.         menuname(clink)=link.name
  50.         i=instr(menuname(clink),".")
  51.         menuname(clink)=left(menuname(clink),i-1)
  52.         menuname(clink)=replace(menuname(clink),"Zßstupce -","")
  53.         menuname(clink)=replace(menuname(clink),"Shortcut to ","")
  54.  
  55.         set multilink=MyShell.CreateShortcut(link.path)
  56.         Ziel(clink)=multilink.Targetpath
  57.         Ziel(clink)=replace(Ziel(clink),chr(34),"")
  58.         Parameter(clink)=multilink.Arguments
  59.         if myFiles.FolderExists(Ziel(clink)) then
  60.             ziel(clink)="explorer.exe /n," & chr(34) & ziel(clink) & chr(34)
  61.             Programm(clink)="explorer.exe"
  62.         else
  63.             temp=lcase(right(ziel(clink),4))
  64.             if temp=".exe" or temp=".com" or temp=".bat" then
  65.                 Programm(clink)=Ziel(clink)
  66.                 Ziel(clink)=chr(34) & Ziel(clink) & chr(34) & " " & parameter(clink)
  67.             else
  68.                 ftype=myShell.regread("HKCR\" & temp & "\")
  69.                 programm(clink)=myShell.regread("HKCR\" & ftype & "\shell\open\command\")
  70.                 programm(clink)=replace(programm(clink),chr(34),"")
  71.                 i=instr(lcase(programm(clink)),".exe")
  72.                 if i=0 then i=instr(lcase(programm(clink)),".com")
  73.                 if i=0 then i=instr(lcase(programm(clink)),".bat")
  74.                 programm(clink)=left(programm(clink),i+3)
  75.                 ziel(clink)=chr(34) & programm(clink) & chr(34) & " " & chr(34) & ziel(clink) & chr(34)
  76.             end if
  77.             ziel(clink)=replace(ziel(clink),"%SystemRoot%",myEnv("SYSTEMROOT"))
  78.             ziel(clink)=replace(ziel(clink),"%ProgramFiles%",myEnv("PROGRAMFILES"))
  79.             programm(clink)=replace(programm(clink),"%SystemRoot%",myEnv("SYSTEMROOT"))
  80.             programm(clink)=replace(programm(clink),"%ProgramFiles%",myEnv("PROGRAMFILES"))
  81.         end if    
  82.     Ziel(clink)=inputbox("Zkontrolujte prosφm, zßstupce..."," Vytvo°it multifunkΦnφ ikonu",Ziel(clink))
  83.     end if
  84. next
  85.  
  86. if clink=0 then
  87.     msgbox "Ve slo₧ce " & tempfolder & " nebyly nalezeni ₧ßdnφ zßstupci.",," Multilink"
  88.     myFiles.DeleteFolder tempfolder,True
  89.     wscript.quit
  90. end if
  91.  
  92. for temp=1 to clink
  93.     allmenus=allmenus & "(" & temp & ") " & menuname(temp) & chr(13)
  94. next
  95.  
  96. mainjob=inputbox(clink & " Byly nalezeni zßstupci. Vyberte hlavnφho zßstupce:" & chr(13) & chr(13) & allmenus," Vytvo°it multifunkΦnφ ikonu")
  97. for temp=1 to clink
  98.     if mainjob = cstr(temp) then mainok=1
  99. next
  100.  
  101. if mainok=0 then 
  102.     msgbox "Nevybrali jste ₧ßdnΘho hlavnφho zßstupce.",,"P°eruÜit"
  103.     myFiles.DeleteFolder tempfolder,True
  104.     wscript.quit
  105. end if
  106.  
  107. if Parameter(mainjob)="" then
  108.     MainCommand=ziel(mainjob) & " %*"
  109. else
  110.     MainCommand=ziel(mainjob) & " " & Parameter(mainjob) & " %*"
  111. end if
  112.  
  113. do
  114.     count=count + 1
  115.     regkey="HKCR\.089" & count & "\" 
  116.     err.clear
  117.     tmp=myshell.regRead(regkey)
  118. loop while err.number=0
  119.  
  120. Dateityp=".089" & count
  121. datei=mydesktop & "\" & menuname(mainjob) & Dateityp
  122.  
  123. if programm(mainjob)="explorer.exe" then
  124.     symbol="Shell32.dll,3"
  125. else
  126. msgbox programm(mainjob)
  127.     if ucase(right(programm(mainjob),4))=".EXE" then 
  128.         symbol=programm(mainjob) & ",0"
  129.     else
  130.         symbol="pifmgr.dll," & count        
  131.     end if
  132. end if
  133.  
  134. myshell.regwrite("HKCR\" & Dateityp & "\"),""
  135. myshell.regwrite("HKCR\" & Dateityp & "\NeverShowExt"),""
  136. myshell.regwrite("HKCR\" & Dateityp & "\DefaultIcon\"),symbol
  137. myshell.regwrite("HKCR\" & Dateityp & "\ScriptEngine\"),"VBScript"
  138. myshell.regwrite("HKCR\" & Dateityp & "\Shell\"),""
  139. myshell.regwrite("HKCR\" & Dateityp & "\Shell\Open\"),menuname(mainjob)
  140. myshell.regwrite("HKCR\" & Dateityp & "\Shell\Open\Command\"),maincommand
  141. myshell.regwrite("HKCR\" & Dateityp & "\ShellEx\"),""
  142. myshell.regwrite("HKCR\" & Dateityp & "\ShellEx\DropHandler\"),"{60254CA5-953B-11CF-8C96-00AA00B8708C}"
  143. myshell.regwrite("HKCR\" & Dateityp & "\Shell\{Poznßmky}\"),""
  144. myshell.regwrite("HKCR\" & Dateityp & "\Shell\{Poznßmky}\Command\"),"notepad.exe " & datei
  145.  
  146. for temp=1 to clink
  147.     if cstr(temp) <> cstr(mainjob) then 
  148.         myshell.regwrite("HKCR\" & Dateityp & "\Shell\" & menuname(temp) & "\"),""
  149.         myshell.regwrite("HKCR\" & Dateityp & "\Shell\" & menuname(temp) & "\Command\"),ziel(temp) & " " & parameter(temp)
  150.     end if
  151. next
  152.  
  153. set multilink=myFiles.CreateTextFile(datei)
  154. multilink.writeline ".LOG   ---  POZN┴MKY  ---  POZN┴MKY  ---  POZN┴MKY  ---"
  155. multilink.close
  156. myFiles.DeleteFolder tempfolder,True
  157.  
  158. '------------------------------------------------------------------------------
  159. Sub DeleteLink (ByVal Datei)
  160. Erweiterung=myFiles.GetExtensionName(datei)
  161. if left(erweiterung,3)<>"089" then
  162.     msgbox "UpuÜt∞n² objekt nenφ multifunkΦnφ ikona...",," Odstranit multifunkΦnφ ikonu"
  163.     wscript.quit
  164. end if
  165. tmp=msgbox("Chcete odstranit soubor " & (datei & chr(13) & "a z registru zßznam o typu souboru " & Erweiterung _
  166.     & " ?"),4," Odstranit multifunkΦnφ ikonu")
  167. if tmp=7 then wscript.quit
  168. tmp=myFiles.DeleteFile(datei,TRUE)
  169. Import=myDesktop & "\pcwtemp.reg"
  170. set myImport=myFiles.CreateTextFile(Import)
  171. myImport.writeline "REGEDIT4"
  172. myImport.writeline ""
  173. myImport.writeline "[-HKEY_CLASSES_ROOT\." & erweiterung & "]"
  174. myImport.close
  175. wscript.sleep 500
  176. myShell.run "regedit.exe /s " & chr(34) & Import & chr(34),,TRUE
  177. wscript.sleep 500
  178. tmp=myFiles.DeleteFile(import,TRUE)
  179. end sub
  180.